Excel VBA 的眉眉角角Day28: SQL運用

DAY 28

Excel VBA 的眉眉角角系列第 28 篇

鐵人賽

Andy Chiu

2014-10-20 11:36:46

46687 瀏覽

分享至

Excel可以透過VBA與SQL語言來進行資料運算，但使用上不如MS Access來的方便，雖然如此，對於熟悉SQL語句的人而言，這真是如獲至寶，這寶貝叫做ADO，只要安裝好Office，它就一直存在，而我們只要了解它、運用它，就等於有了這個寶貝！

以下是我個人製作的一個Function，主要是使用SQL語句來操作Excel檔案，資料來源可以是外部檔案，或同檔案，透過此程式，可以指定產生資料後要存放的工作表，儲存前是否先清除工作表內容，存到該工作表的起始於哪個欄位，資料產生後，是否自動調整欄位大小。以此方式來操作ADO，可減輕不少程式撰寫工作，只須把參數帶入，即可產生所需的統計資料到指定的位置。以下讓我們來看程式內容：

Public Function SQL(strCommandText As String, Optional strXLSFileName As String, Optional strSheetName As String, Optional bnGotoSheet As Boolean = True, Optional bnDelSht As Boolean = True, Optional iRow As Integer = 1, Optional iCol As Integer = 1, Optional bnNoField As Boolean = False, Optional bnNoAutoFit As Boolean = False)
    
    '參考資料：
    '如何從 Visual Basic 或 VBA 搭配使用 ADO 與 Excel 資料
    ' http://support2.microsoft.com/kb/257819/zh-tw
    
    '變數介紹：
    
    '必要：
    'strCommandText:  SQL語句
    
    '選擇性
    'strXLSFileName: Excel檔案完整路徑，預設為執行的Excel檔案
    'strSheetName: 存放結果的工作表名稱，未指定則程式會建立一個工作表存放結果
    'bnGotoSheet: 是否跳到存放結果的工作表？預設為是
    'bnDelSht: 若指定存放工作表，是否清除原工作表內容，預設清除
    'iRow : 存放列，預設1
    'iCol : 存放欄，預設1
    'bnNoField : 不包含表頭，預設含表頭
    'bnNoAutoFit : 不自動調整儲存格大小，預設自動調整大小
    '
    
    Dim strConnectString As String
    Dim vADODBConnection As Variant
    Dim vADODBRecordset As Variant
    Dim objWrkSht As Object

    Application.ScreenUpdating = False
    
    If strXLSFileName = "" Then
        strXLSFileName = ActiveWorkbook.FullName
    End If
    
    strConnectString = "Driver={Microsoft Excel Driver (*.xls)}; " & _
                                        "DBQ=" & strXLSFileName & ";" & _
                                        "ReadOnly=True"
    
    Set vADODBConnection = CreateObject("ADODB.Connection")
    Set vADODBRecordset = CreateObject("ADODB.Recordset")
    
    vADODBConnection.Open strConnectString
    vADODBRecordset.Open strCommandText, vADODBConnection, 3, 1, 1
    
    If strSheetName = "" Then
        Sheets.Add
        Set objWrkSht = ActiveSheet
    Else
       If bnGotoSheet = True Then Sheets(strSheetName).Select
        Set objWrkSht = Sheets(strSheetName)
        If bnDelSht = True Then
            objWrkSht.Cells.Clear
        End If
    End If
    
    Dim f As Integer
    'r = 1
    If iRow = 0 Then iRow = 1
    If iCol = 0 Then iCol = 1
    
    If bnNoField <> True Then
        For f = 0 To vADODBRecordset.Fields.Count - 1
            objWrkSht.Cells(iRow, f + iCol).Value = vADODBRecordset.Fields(f).Name
        Next
    End If
    
    While Not vADODBRecordset.EOF
        iRow = iRow + 1
        For f = 0 To vADODBRecordset.Fields.Count - 1
            objWrkSht.Cells(iRow, f + iCol).Value = vADODBRecordset.Fields(f).Value
        Next
        vADODBRecordset.movenext
    Wend
        
    vADODBConnection.Close
    
    If bnNoAutoFit <> True Then
        'objWrkSht.Activate
        objWrkSht.Cells.Rows.AutoFit
        objWrkSht.Cells.Columns.AutoFit
        'objWrkSht.Cells(1, 1).Select
    End If
    
    Application.ScreenUpdating = True
    
End Function

以下兩個範例，分別有外部檔案與同檔案進行不同的SQL語句處理：

範例一：由外部檔案彙整資料至Day28工作表，統計血型數量

Sub Day28_1()
Dim strXLSFileName As String
Dim strCommandText As String

strXLSFileName = "\\ntsvr\Public\mis\SQL_TEST.xls"
    strCommandText = "SELECT A.血型 , COUNT(A.血型) AS 總數 " & _
                     "FROM [Data$] AS A " & _
                     "GROUP BY A.血型 "
                     
Call SQL(strCommandText, strXLSFileName, "Day28", True, 1, 1, False, False)

End Sub

外部檔案資料如下：

產生出來的資料如下：

範例二：由本地檔案Day2工作表彙整資料至Day28工作表，統計姓氏數量並遞減排序

Sub Day28_2()
    Dim strXLSFileName As String
    Dim strCommandText As String

    strCommandText = "SELECT LEFT((A.姓名),1) AS 姓氏 , COUNT(LEFT((A.姓名),1)) AS 總數 " & _
                     "FROM [Day2$] AS A " & _
                     "GROUP BY LEFT((A.姓名),1) " & _
                     "ORDER BY COUNT(LEFT((A.姓名),1)) DESC;"
                     
    Call SQL(strCommandText, strXLSFileName, "Day28", True, True, 1, 1, False, False)

End Sub

外部檔案資料如下：